home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-01 / ifp1s155.zip / PAGE_13.PAS < prev    next >
Pascal/Delphi Source File  |  1992-04-21  |  6KB  |  246 lines
  1. unit page_13;
  2.  
  3. interface
  4.  
  5. uses crt, dos, ifpglobl, ifpcomon;
  6.  
  7. procedure page13;
  8.  
  9. implementation
  10.  
  11. procedure page13;
  12. type
  13.   iotbltype = record
  14.                 spclfunc: byte;
  15.                 devtype: byte;
  16.                 devattr: word;
  17.                 cylcount: word;
  18.                 medtype: byte;
  19.                 bpsec: word;
  20.                 secpclus: byte;
  21.                 resvsec: word;
  22.                 fats: byte;
  23.                 rootentries: word;
  24.                 numsecs: word;
  25.                 meddescr: byte;
  26.                 secpfat: word;
  27.                 secptrk: word;
  28.                 numheads: word;
  29.                 numhidden: longint;
  30.                 largesec: longint;
  31.                 reserved: array[$19..$1E] of byte;
  32.               end;
  33.  
  34. var
  35.   i : $00..$2B;
  36.   xbyte : byte;
  37.   xchar : char;
  38.   xFCB : array[$00..$2B] of byte;
  39.   xlong : longint;
  40.   xstring : string;
  41.   xword1 : word;
  42.   xword2 : word;
  43.   xword3, xword4, xword5: word;
  44.   iotable: iotbltype;
  45.   saveX, saveY: byte;
  46.  
  47.   begin
  48.   caption2('LASTDRIVE');
  49.   drvname(lastdrv - 1);
  50.   writeln;
  51.   caption2('Logical drives');
  52.   with regs do
  53.     begin
  54.     for xchar:='A' to 'Z' do
  55.       begin
  56.       AH:=$0E;
  57.       DL:=ord(xchar) - ord('A');
  58.       MSDOS(regs);
  59.       AH:=$19;
  60.       MSDOS(regs);
  61.       if AL = DL then
  62.         drvname(AL)
  63.       end;
  64.     writeln;
  65.     AH:=$0E;
  66.     DL:=currdrv;
  67.     MSDOS(regs)
  68.     end;
  69.   caption2('Diskette drives');
  70.   if equip and $0001 = $0001 then
  71.     writeln(1 + equip and $00C0 shr 6)
  72.   else
  73.     writeln(0);
  74.   xword1:=longint(intvec[$1E]) shr 16;
  75.   xword2:=longint(intvec[$1E]) and $0000FFFF;
  76.   caption3('Sectors/track');
  77.   writeln(Mem[xword1 : xword2 + 4]);
  78.   caption3('Bytes/sector');
  79.   writeln(Mem[xword1 : xword2 + 3] shl 8);
  80.   caption3('On time (ms)');
  81.   writeln(125 * Mem[xword1 : xword2 + 10]);
  82.   caption3('Off time (s)');
  83.   writeln(longint(Mem[xword1 : xword2 + 2]) shl 16 / tick1:0:1);
  84.   caption3('Head settle time (ms)');
  85.   writeln(Mem[xword1 : xword2 + 9]);
  86.   caption1('  Single drive is now ');
  87.   xbyte:=Mem[BIOSdseg : $0104];
  88.   if xbyte <= ord('Z') - ord('A') then
  89.     begin
  90.     drvname(xbyte);
  91.     writeln
  92.     end
  93.   else
  94.     if xbyte = $FF then
  95.       writeln('N/A')
  96.     else
  97.       unknown('status', xbyte, 2);
  98. (*  Byte 12:12 p.178  *)
  99.   caption2('Current drive and path');
  100.   GetDir(0, xstring);
  101.   Writeln(xstring);
  102.   with regs do
  103.     begin
  104.     AH:=$52;
  105.     MsDos(regs);
  106.     if (osmajor = 3) and (osminor = 0) then
  107.       begin
  108.       xword1:=MemW[ES:BX + $19];
  109.       xword2:=MemW[ES:BX + $17]
  110.       end
  111.     else
  112.       begin
  113.       xword1:=MemW[ES:BX + $18];
  114.       xword2:=MemW[ES:BX + $16]
  115.       end;
  116.     if (osmajor >= 4) and (osmajor < 10) then
  117.       xword5:=$58
  118.     else
  119.       xword5:=$51;
  120.     xword3:=xword2 + (xword5 * currdrv);
  121.     caption3('Drive type is');
  122.     case MemW[xword1:xword3 + $43] shr 14 of
  123.       0: Writeln('invalid');
  124.       1: Writeln('physical');
  125.       2: Writeln('network');
  126.       3: Writeln('Installable File System')
  127.     end;
  128.     if (osmajor >= 4) or ((osmajor = 3) and (osminor >= 20)) then
  129.       with regs do
  130.         begin
  131.         AH:=$44;
  132.         AL:=$0D;
  133.         BL:=0;
  134.         CH:=8;
  135.         CL:=$60;
  136.         DS:=Seg(iotable);
  137.         DX:=Ofs(iotable);
  138.         MsDos(regs);
  139.         if Flags and FCarry = 0 then
  140.           with iotable do
  141.             begin
  142.             caption3('removable');
  143.             if devattr and 1 = 0 then
  144.               Write('yes')
  145.             else
  146.               Write('no');
  147.             caption3('door lock');
  148.             yesorno(devattr and 2 = 2);
  149.             end
  150.         end;
  151.     caption3('JOIN''d ');
  152.     if MemW[xword1:xword3 + $43] and $2000 = $2000 then
  153.       begin
  154.       Write('yes');
  155.       caption3('actually');
  156.       xword4:=xword3;
  157.       while Mem[xword1:xword4] <> 0 do
  158.         begin
  159.         Write(Chr(Mem[xword1:xword4]));
  160.         Inc(xword4)
  161.         end;
  162.       Writeln;
  163.       end
  164.     else
  165.       Writeln('no');
  166.     caption3('SUBST''d');
  167.     if MemW[xword1:xword3 + $43] and $1000 = $1000 then
  168.       begin
  169.       Write('yes');
  170.       caption3('actually');
  171.       xword4:=xword3;
  172.       while Mem[xword1:xword4] <> 0 do
  173.         begin
  174.         Write(Chr(Mem[xword1:xword4]));
  175.         Inc(xword4)
  176.         end;
  177.       Writeln;
  178.       end
  179.     else
  180.       Writeln('no')
  181.     end;
  182.   caption3('Volume label');
  183.   for i:=$00 to $2B do
  184.     xFCB[i]:=$00;
  185.   xFCB[$00]:=$FF;         (* extended FCB *)
  186.   xFCB[$06]:=$08;         (* volume ID attribute *)
  187.   for i:=$08 to $12 do
  188.     xFCB[i]:=ord('?');
  189.   with regs do
  190.     begin
  191.     AH:=$11;
  192.     DS:=seg(xFCB);
  193.     DX:=ofs(xFCB);
  194.     MSDOS(regs);
  195.     case AL of
  196.       $00 : begin
  197.             AH:=$2F;
  198.             MSDOS(regs);
  199.             i:=$08;
  200.             xchar:=char(Mem[ES : BX + i]);
  201.             while (i <= $12) and (xchar > #0) do
  202.               begin
  203.               write(showchar(xchar));
  204.               inc(i);
  205.               xchar:=char(Mem[ES : BX + i])
  206.               end;
  207.             writeln
  208.             end;
  209.       $FF : writeln('(none)')
  210.     else
  211.       unknown('status', AL, 2)
  212.     end {case}
  213.     end;
  214.   with regs do
  215.     begin
  216.     saveX:=WhereX;
  217.     saveY:=WhereY;
  218.     TextColor(LightRed+Blink);
  219.     Write('  *retrieving information*');
  220.     AH:=$1B;
  221.     MSDOS(regs);
  222.     GotoXY(saveX, saveY);
  223.     Write('                          ');
  224.     GotoXY(saveX, saveY);
  225.     media(Mem[DS : BX], AL);
  226.     caption3('Clusters');
  227.     writeln(DX);
  228.     caption3('Sectors/cluster');
  229.     writeln(AL);
  230.     caption3('Bytes/sector');
  231.     writeln(CX)
  232.     end;
  233.   caption3('Total space (bytes)');
  234.   xlong:=disksize(0);
  235.   if xlong <> -1 then
  236.     writeln(xlong : 8)
  237.   else
  238.     writeln('(invalid drive)');
  239.   caption3('Free space (bytes) ');
  240.   xlong:=diskfree(0);
  241.   if xlong <> -1 then
  242.     write(xlong : 8)
  243.   else
  244.     write('(invalid drive)')
  245. end;
  246. end.